;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Constructs Histograms, Vertical Bar Charts and Frequency Polygons
;;
;; Version I: Jan de Leeuw and Jason  Bond, 1994-5
;; Constructs frequency polygons, histograms and hollow histograms
;; providing an Xlisp-Stat version of the S-routines in Haerdle's book.
;; Calculates optimal initial bin-widths based on Scott's article.
;; Fits least squares normal-density and allows non-equal bin-widths.
;; Includes slider to dynamically change bin-widths when equal.
;;
;; Version II: Forrest Young, 1998
;; Completely new object built arround the same plotting algorithms.
;; The new object adds bar graphs; replaces (buggy) least squares 
;; normal-density fitting algorithm with non-least-squares code;
;; adds kernel-density fitting code; replaces menu and slider with
;; buttons; adds color and ability to use n-dimensional data and to
;; change to entirely new data.
;; 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;; generic functions

(defun histofreq (data &key binwidth origin cutpoints histo prob
                       (title "Frequency Plot") new-x (new-y t)
                       (bottom-tool-bar t) (content-only nil)
                       (legend1 (send current-object :name))
                       (legend2 "Frequency Polygon")
                       location size (go-away t) (show t) sort
                       variable-labels auto-sort)
"HISTOFREQ makes histograms and frequency polygon plots from raw data, calculating frequencies from the raw data. 
Args: DATA HISTO PROB BINWIDTH ORIGIN CUTPOINTS SORT VARIABLE-LABELS BOTTOM-TOOL-BAR LEGEND1 LEGEND2 LOCATION SIZE GO-AWAY SHOW CONTENT-ONLY
Required Arg: 
DATA, a list (or vector) of variable values, or a list of lists (or vectors) of several variables. The first variable is plotted initially. 
Keyword Args: 
When HISTO is T the initial plot is a histogram, otherwise it is a frequency polygon. The y-axis is initially probabilities if PROB is T, frequencies otherwise.
BINWIDTH ORIGIN CUTPOINTS each of which must be a list of values, one for each variable. Any given value may be nil. If not used the values will be calculated.  
When BOTTOM-TOOL-BAR is T buttons appear on a bar at the bottom. When NEW-X is T then a new-x button is put on tool-bar (default nil);  When NEW-Y is T then a new-y button is put on the tool-bar to control y-axis representing frequencies or probabilities (default t). Has the standard arguments TITLE LOCATION SIZE (GO-AWAY T) (SHOW T) and VARIABLE-LABELS.
When auto-sort the data are sorted."
  (send histofreq-proto :new data :poly (not histo) :prob prob 
        :binwidth binwidth :origin origin :cutpoints cutpoints 
        :title title  :location location :size size :go-away go-away 
        :show show :variable-labels variable-labels :new-x new-x :new-y new-y
        :bottom-tool-bar bottom-tool-bar :legend1 legend1 :legend2 legend2 
        :content-only content-only :auto-sort auto-sort))


(defproto histofreq-proto 
  '(data-list       ;; the data - list of lists
    data            ;; the current variables data - a list
    num-data-variables ;; the number of variables in the data. Not the same
                       ;; as :num-variables, which is always 2
    current-varnum  ;; the number of the current variable
    binwidth        ;; the binwidth of the current variable
    binwidth-list   ;; list of binwidth lists, one for each variable
    origin          ;; the origin
    histo           ;; plot histogram ?
    poly            ;; plot frequency polygon ?
    bar             ;; bar-chart ?
    prob            ;; counts or probabilities
    full-hist       ;; is the histogram full or hollow ?
    with-points     ;; does the plot have midpoints on it ?
    counts          ;; bin-counts
    cut-points      ;; cut-points for bins
    mid-points      ;; mid-points of bins
    button-overlay  ;; objid of button overlay
    color           ;; color type
    line-width      ;; width of lines
    sort            ;; sort data?
    empty
    freqs
    legend1
    legend2
    original-bottom-margin
    margin-flag
    n-label-lines
    cat-labels
    category-labels
    show-normal
    show-kernel
    show-density
    kernel-type
    max-normal-pixel
    dens-dialog
    normal-curve-color
    kernel-curve-color
    lowest-bin-value
    bar-chart-legend2 ;; used by new-bins method bar chart legend2 
    new-xmin-value    ;; used by new-bins method x-axis minimum
    new-xmax-value    ;; used by new-bins method x-axis maximum
    new-ntic-value    ;; used by new-bins method x-axis ntics
    auto-sort ;;PV sorts the values in descending order? 
    content-only
    )
  ()
  scatterplot-proto) ;scatterplot-proto


;;slot-accessor methods

(defmeth histofreq-proto :new-xmin-value (&optional (values nil set))
  (if set (setf (slot-value 'new-xmin-value) values))
  (slot-value 'new-xmin-value))

(defmeth histofreq-proto :new-xmax-value (&optional (values nil set))
  (if set (setf (slot-value 'new-xmax-value ) values))
  (slot-value 'new-xmax-value ))

(defmeth histofreq-proto :new-ntic-value (&optional (values nil set))
  (if set (setf (slot-value 'new-ntic-value) values))
  (slot-value 'new-ntic-value))
(defmeth histofreq-proto :lowest-bin-value (&optional (values nil set))
  (if set (setf (slot-value 'lowest-bin-value) values))
  (slot-value 'lowest-bin-value))

(defmeth histofreq-proto :data (&optional (values nil set))
  (if set (setf (slot-value 'data) values))
  (slot-value 'data))

(defmeth histofreq-proto :data-list (&optional (values nil set))
  (if set (setf (slot-value 'data-list) values))
  (slot-value 'data-list))

(defmeth histofreq-proto :num-data-variables (&optional (values nil set))
  (if set (setf (slot-value 'num-data-variables) values))
  (slot-value 'num-data-variables))

(defmeth histofreq-proto :current-varnum (&optional (values nil set))
  (if set (setf (slot-value 'current-varnum) values))
  (slot-value 'current-varnum))

(defmeth histofreq-proto :binwidth (&optional (values nil set))
  (if set (setf (slot-value 'binwidth) values))
  (slot-value 'binwidth))

(defmeth histofreq-proto :binwidth-list (&optional (values nil set))
  (if set (setf (slot-value 'binwidth-list) values))
  (slot-value 'binwidth-list))

(defmeth histofreq-proto :origin (&optional (values nil set))
  (if set (setf (slot-value 'origin) values))
  (slot-value 'origin))

(defmeth histofreq-proto :histo (&optional (values nil set))
  (if set (setf (slot-value 'histo) values))
  (slot-value 'histo))

(defmeth histofreq-proto :bar (&optional (values nil set))
  (if set (setf (slot-value 'bar) values))
  (slot-value 'bar))

(defmeth histofreq-proto :poly (&optional (values nil set))
  (if set (setf (slot-value 'poly) values))
  (slot-value 'poly))

(defmeth histofreq-proto :full-hist (&optional (values nil set))
  (if set (setf (slot-value 'full-hist) values))
  (slot-value 'full-hist))

(defmeth histofreq-proto :with-points (&optional (values nil set))
  (if set (setf (slot-value 'with-points) values))
  (slot-value 'with-points))

(defmeth histofreq-proto :prob (&optional (values nil set))
  (if set (setf (slot-value 'prob) values))
  (slot-value 'prob))

(defmeth histofreq-proto :counts (&optional (values nil set))
  (if set (setf (slot-value 'counts) values))
  (slot-value 'counts))

(defmeth histofreq-proto :cut-points (&optional (values nil set))
  (if set (setf (slot-value 'cut-points) values))
  (slot-value 'cut-points))

(defmeth histofreq-proto :mid-points (&optional (values nil set))
  (if set (setf (slot-value 'mid-points) values))
  (slot-value 'mid-points))

(defmeth histofreq-proto :button-overlay (&optional (values nil set))
  (if set (setf (slot-value 'button-overlay) values))
  (slot-value 'button-overlay))

(defmeth histofreq-proto :line-width (&optional (values nil set))
  (if set (setf (slot-value 'line-width) values))
  (slot-value 'line-width))

(defmeth histofreq-proto :color (&optional (values nil set))
  (if set (setf (slot-value 'color) values))
  (slot-value 'color))

(defmeth histofreq-proto :normal-curve-color (&optional (symbol nil set))
  (if set (setf (slot-value 'normal-curve-color ) symbol))
  (slot-value 'normal-curve-color ))

(defmeth histofreq-proto :kernel-curve-color (&optional (symbol nil set))
  (if set (setf (slot-value 'kernel-curve-color ) symbol))
  (slot-value 'kernel-curve-color ))

(defmeth histofreq-proto :content-only (&optional (logical nil set))
  (unless (send self :has-slot 'content-only)
          (send self :add-slot 'content-only))
  (if set (setf (slot-value 'content-only) logical))
  (slot-value 'content-only))
    
(defmeth histofreq-proto :show-normal (&optional (logical nil set))
  (if set (setf (slot-value 'show-normal) logical))
  (slot-value 'show-normal))
    
(defmeth histofreq-proto :show-kernel (&optional (logical nil set))
  (if set (setf (slot-value 'show-kernel) logical))
  (slot-value 'show-kernel))
    
(defmeth histofreq-proto :show-density (&optional (logical nil set))
  (if set (setf (slot-value 'show-density) logical))
  (slot-value 'show-density))
    
(defmeth histofreq-proto :kernel-type (&optional (logical nil set))
  (if set (setf (slot-value 'kernel-type) logical))
  (slot-value 'kernel-type))

(defmeth histofreq-proto :empty (&optional (logical nil set))
  (if set (setf (slot-value 'empty) logical))
  (slot-value 'empty))

(defmeth histofreq-proto :original-bottom-margin (&optional (integer nil set))
  (if set (setf (slot-value 'original-bottom-margin) integer))
  (slot-value 'original-bottom-margin))

(defmeth histofreq-proto :legend1 (&optional (string nil set))
  (if set (setf (slot-value 'legend1) string))
  (slot-value 'legend1))

(defmeth histofreq-proto :legend2 (&optional (string nil set))
  (if set (setf (slot-value 'legend2) string))
  (slot-value 'legend2))


(defmeth histofreq-proto :bar-chart-legend2 (&optional (string nil set))
  (if set (setf (slot-value 'bar-chart-legend2 ) string))
  (slot-value 'bar-chart-legend2 ))

(defmeth histofreq-proto :cat-labels (&optional (string-list nil set))
  (if set (setf (slot-value 'cat-labels ) string-list))
  (slot-value 'cat-labels))

(defmeth histofreq-proto :category-labels (&optional (string-list nil set))
  (if set (setf (slot-value 'category-labels ) string-list))
  (slot-value 'category-labels))

(defmeth histofreq-proto :variable-labels (&optional (string-list nil set))
  (if set (setf (slot-value 'variable-labels ) string-list))
  (slot-value 'variable-labels))

(defmeth histofreq-proto :sort (&optional (logical nil set))
  (if set (setf (slot-value 'sort) logical))
  (slot-value 'sort))

(defmeth histofreq-proto :freqs (&optional (logical nil set))
  (if set (setf (slot-value 'freqs) logical))
  (slot-value 'freqs))

(defmeth histofreq-proto :margin-flag (&optional (logical nil set))
  (if set (setf (slot-value 'margin-flag) logical))
  (slot-value 'margin-flag))

(defmeth histofreq-proto :n-label-lines (&optional (number nil set))
  (if set (setf (slot-value 'n-label-lines) number))
  (slot-value 'n-label-lines))

(defmeth histofreq-proto :auto-sort (&optional (logical nil set))
  (if set (setf (slot-value 'auto-sort) logical))
  (slot-value 'auto-sort))

(defmeth histofreq-proto :spreadplot-object (&optional (objid nil set))
  (unless (send self :has-slot 'spreadplot-object)
          (send self :add-slot 'spreadplot-object))
  (if set (setf (slot-value 'spreadplot-object) objid))
  (slot-value 'spreadplot-object))


(defmeth histofreq-proto :create-data-object ()
  (send self :create-freq-data :stat-obj (send self :data-object)))

(defmeth histofreq-proto :isnew 
  (data &key binwidth origin cutpoints poly bar freqs prob title 
        legend1 legend2 location size go-away show variable-labels 
        category-labels new-x new-y sort content-only auto-sort)
  (call-next-method 2 :title title location location :size size 
      :go-away go-away :show nil)
  (send self :content-only content-only)
  (when (not variable-labels)
        (setf variable-labels (repeat nil (length data)))
        (mapcar #'(lambda (i) 
                    (setf (select variable-labels i)
                          (strcat "Var" (format nil "~A" i))))
                (iseq (length data))))
  (when (or (stringp variable-labels) 
            (numberp variable-labels))
        (setf variable-labels (list variable-labels)))
  (when (vectorp variable-labels) (coerce variable-labels 'list))
  
  (send self :variable-labels variable-labels)
  (send self :freqs freqs)
  (if freqs 
      (setf data 
            (send self :prepare-freqs data category-labels
                  variable-labels binwidth))
      (setf data
            (send self :prepare-data data 
                  :binwidth binwidth :origin origin :cutpoints cutpoints
                  :poly poly :prob prob :variable-labels variable-labels 
                  :freqs freqs :category-labels category-labels)))

  (when (and (/= (length variable-labels) (length data))
             (not (listp (first variable-labels))))
        (setf variable-labels (send self :massage-data variable-labels)))
 (when (/= (length variable-labels) (length data))
        (fatal-message "HistoFreq: The number of variable labels does not equal the number of lists of data."))
  (send self :category-labels category-labels)
  (send self :full-hist (if bar t nil))
  (send self :with-points t)
  (send self :prob prob)
  (send self :bar bar)
  (send self :sort sort)
  (send self :mouse-mode 'brushing)
  (send self :showing-labels t)
  (send self :brush 0 0 12 10)
  (send self :make-two-plot-menus
                (if poly "FreqPlot" "HistoPlot")
                :hotspot-items '(help dash new-x new-y dash
                              create-data dash
                              print save copy)
                :popup-items   '(showing-labels mouse))
  (send self :legend1 (if legend1 legend1 (send current-object :name)))
  (send self :legend2 (if legend2 legend2 " "))
  (send self :histo (not poly)) ;(if bar t (not poly))
  (send self :poly poly)
  (send self :title (if poly "Dynamic Frequency Plot" "Dynamic Histogram"))
  (send self :auto-sort auto-sort)
  (send self :button-overlay 
        (if (send self :bar)
            (send self :plot-buttons  
                  :new-x new-x :new-y new-y :mouse-mode nil)
            (send self :plot-buttons  :new-x new-x :new-y new-y :bins t
                  :bottom-tool-bar t
                  :mouse-mode nil :curves t :bin2 t :plot t :savedata t)))
  (send self :color 'blue)
  (send self :line-width 2)
  (send self :new-plot 0 :origin origin :cutpoints cutpoints)
  (if (send self :bar)
      (send self :x-axis t nil 0))
  (apply #'send self :margin 
        (- (send self :margin) (list 6 0 25 0)))
  (when show (send self :show-window))
  (send (send self :menu) :title (if poly "FreqPlot" "HistoPlot"))
  self
  )

(defmeth histofreq-proto :new-plot-data 
      (data &key poly bar (prob nil set) variable-labels)
  (when (and poly bar) 
        (error "Cannot use both poly and bar arguments at the same time"))
  (let ((binwidth (if bar (list .5) nil)))
    (when set (send self :prob prob))
    (send self :prepare-data data :poly poly :bar bar :prob (send self :prob) 
          :binwidth binwidth :variable-labels variable-labels)
    (send self :show-new-var "X" (select (send self :variable-labels) 0))
    ))

(defmeth histofreq-proto :prepare-data 
  (data &key binwidth origin cutpoints poly prob variable-labels)
  (let ((ndim nil)
        (internal-data (send self :massage-data data))
        )
    (send self :data-list (if (send self :sort)
                              (mapcar #'sort-data internal-data)
                              internal-data))
    (setf ndim (length (send self :data-list)))
    (send self :num-data-variables ndim)
;(printlist (list prob variable-labels))
    (when (stringp variable-labels)
          (setf variable-labels (list variable-labels)))
    (setf variable-labels (combine variable-labels 
                                   (if prob "Bin Probability" "Bin Frequency"  )))
;(print variable-labels)
    (if binwidth
        (send self :binwidth-list binwidth)
        (send self :binwidth-list (repeat nil ndim)))
    (send self :variable-labels variable-labels)
    (send self :variable-label 1 (if prob "Bin Probability" "Bin Frequency"))
    (send self :data-list)))


(defmeth histofreq-proto :prepare-freqs (freq-list cat-names var-names binwidth)
  (let* ((nvars (length freq-list))
         (prob (send self :prob))
         (count-list)
         (counts)
         (freqs)
         (ncats)
         )
    (dotimes (i nvars)
             (setf freqs (select freq-list i))
             (setf ncats (length freqs))
             (setf counts nil)
             (dotimes (j ncats)
                      (setf counts (add-element-to-list counts 0))
                      (setf counts (add-element-to-list counts (select freqs j))))
             (setf count-list (add-element-to-list count-list (rest counts))))
    (send self :data-list count-list)
    (when (stringp var-names)
          (setf var-names (list var-names)))
    (setf variable-names (combine var-names 
                                  (if prob "Bin Probability" "Bin Frequency")))
    (send self :variable-labels var-names)
    (send self :variable-label 1 (if prob "Bin Probability" "Bin Frequency"))
    (send self :binwidth-list (list binwidth))
    (send self :data-list)))

(defmeth histofreq-proto :massage-data (internal-data)
  (when (vectorp internal-data) 
        (setf internal-data (coerce internal-data 'list)))
  (when (or (numberp (first internal-data))
           (stringp (first internal-data))) 
        (setf internal-data (list internal-data)))
  (when (vectorp (first internal-data))
        (setf internal-data (mapcar #'(lambda (vec) (coerce vec 'list)) internal-data)))
  internal-data)


(defmeth histofreq-proto :show-new-var 
       (axis variable &key binwidth origin cutpoints variable-num)
  (let* ((var-num (if variable-num
                      variable-num
                      (position variable (send self :variable-labels)))))
    (send self :clear-lines :draw nil)
    (send self :new-plot var-num :origin origin :cutpoints cutpoints)
    (when (send self :show-normal) (send self :add-normal))
    (when (send self :show-kernel) 
          (send self :add-kernel (send self :kernel-type)))))

(defmeth histofreq-proto :new-plot
  (varnum &key binwidth origin cutpoints)
  (send self :empty nil)
  (send self :current-varnum varnum)
  (send self :data (select (send self :data-list) varnum))
  (cond
    ((< (length (send self :data)) 3)
     (send self :clear t)
     (send self :x-axis t t 0)
     (send self :variable-label 0 "Frequency Too Low")
     (send self :y-axis t t 0)
     (send self :variable-label 1 "Frequency Too Low")
     (send self :redraw))
    (t
     (send self :variable-label 0 
           (select (send self :variable-labels) varnum))  
     (if (send self :freqs)
         (send self :cat-labels 
               (select (send self :category-labels) varnum))
         (when (send self :bar)
               (let ((result (send self :convert-catvar-to-numvar 
                                   (send self :data))))
                 (send self :cat-labels (first result))
                 (send self :data (second result)))))
     
     (let* ((binwidths (send self :binwidth-list))
            (binwidth-varnow (select binwidths varnum))
            (counts)
            (prob (send self :prob))
            )
       (when (not binwidth-varnow)
             (setf binwidth-varnow (send self :make-binwidth))
             (setf (select binwidths varnum) binwidth-varnow)
             (send self :binwidth-list binwidths))
       (send self :binwidth (select (send self :binwidth-list) varnum))
       ;(break)
       (if origin (send self :origin origin)
           (send self :make-origin))
       
             
       (if (send self :freqs)
           (setf counts (select (send self :data-list) varnum))
           (setf counts (send self :make-counts)))
       (when (send self :auto-sort)
             (setf (select counts (sort-data 
                                   (which (mapcar #'(lambda (val) (not (= val 0))) counts))))
                   (remove '0 (sort-data counts)))) ;PV sorts the values in a barchart
       (send self :counts 
             (if prob (/ counts (sum counts))
                 counts))
       (if cutpoints (send self :cut-points cutpoints)
           (if (send self :bar)
               (send self :cut-points 
                     (+ .5 (iseq (1+ (length counts)))))
               (send self :cut-points (send self :make-cut-points))))
       (when (send self :bar) (send self :bar-cut-points (send self :cut-points)))
       (send self :mid-points (send self :make-mid-points))
       (send self :make-plot)
       ))))
    
(defmeth histofreq-proto :bar-cut-points (cp)
  (dotimes (i (length cp))
           (setf (select cp i) 
                 (if (evenp i) 
                     (- (select cp i) .2)
                     (+ (select cp i) .2)))))

(defmeth histofreq-proto :convert-catvar-to-numvar (catvar)
  (let* ((cats (remove-duplicates catvar :test #'equal))
         (numeric-var (repeat nil (length catvar)))
         )
    (dotimes (j (length cats))
     (setf (select numeric-var
                   (which (mapcar #'(lambda (i) 
                          (equal (select cats j) (select catvar i))) 
                                  (iseq (length catvar))))) j))
    (list cats numeric-var)))

(defmeth histofreq-proto :new-x ()
  (let* ((axis "X")
         (current-varnum (send self :current-varnum))
         (ndim (length (send self :data-list)))
         (result (send self :new-variable-dialog axis 
                       (list current-varnum ndim)))
         )
    (when (> (length result) 0)
          (setf result (select result 0))
          (cond 
            ((not result) (error-message "You must select a variable"))
            (t
             (send self :show-new-var axis result))))))

(defmeth histofreq-proto :new-y ()
  (send self :prob (not (send self :prob)))
  (send self :variable-label 1 
        (if (send self :prob) "Bin Probability" "Bin Frequency"))
  (if (send self :empty)
      (send self :clear t)
      (let ((varnum (position (send self :variable-label 0)
                              (send self :variable-labels) :test #'equal)))
        (send self :new-plot varnum))))
  

(defmeth histofreq-proto :make-show-variables-list (&optional cur-vars)
  (let* ((variables (combine (send self :variable-labels)))
         )
    (when (not cur-vars) (setf cur-vars (send self :current-variables)))
    (set-difference variables (select variables cur-vars))))

;;  Button Support

(defmeth histofreq-proto :switch-plot-type ()
  (send self :start-buffering)
  (cond 
    ((send self :poly)
     (send self :toggle-histo-poly)
     (send self :toggle-full-option))
    ((send self :histo)
     (if (send self :full-hist)
         (send self :toggle-full-option)
         (send self :toggle-histo-poly))))
  (send self :toggle-plot)
  (send self :buffer-to-screen)
  )

(defmeth histofreq-proto :show-density ()
  (send self :show-normal))

(defmeth histofreq-proto :toggle-histo-poly ()
  (send self :histo (not (send self :histo)))
  (send self :poly (not (send self :poly))))

(defmeth histofreq-proto :toggle-full-option ()
  (send self :full-hist (not (send self :full-hist))))

(defmeth histofreq-proto :toggle-midpoint-option ()
  (send self :with-points (not (send self :with-points))))
 
(defmeth histofreq-proto :toggle-normal-item ()
  (send self :show-normal (not (send self :show-normal))))

(defmeth histofreq-proto :new-bins (&optional (direction nil set))
 (let* ((data (send self :data))
        (nobs (length data))
        (sdat (send self :spacing data))
        (rdat (/ (range data) 2))
        (oldbinwid (send self :binwidth))
        (newbinwid nil)
        )
   (cond 
     ((not set)
      (send self :set-bins))
     (t
      (if direction
          (setf newbinwid (+ oldbinwid (/ (- rdat sdat) 50)))
          (setf newbinwid (- oldbinwid (/ (- rdat sdat) 50))))
      (when (> newbinwid 0)
            (send self :binwidth newbinwid)
            (let* ((varnum (send self :current-varnum))
                   (binwidths (send self :binwidth-list))
                   )
              (setf (select binwidths varnum) newbinwid)
              (send self :binwidth-list binwidths))
            (cond 
              ((send self :recompute)
               (send self :start-buffering)
               (send self :make-plot)
               (when (send self :show-normal) (send self :add-normal))
               (when (send self :show-kernel) 
                     (send self :add-kernel (send self :kernel-type)))
               (send self :buffer-to-screen))
              (t
               (send self :binwidth oldbinwid))))))
   ))

(defmeth histofreq-proto :create-freq-data (&key stat-obj)
  (let* ((splot (if stat-obj nil (send self :spreadplot-object)))
         (stobj (if stat-obj stat-obj 
                    (if splot 
                        (send splot :statistical-object)
                        (send self :data-object))))
         (setit (if (not (equal *current-object* stobj)) (setco stobj)))
         (creator-icon (send *desktop* :selected-icon))
         (counts (send self :counts))
         (percents (* 100 (/ counts (sum counts))))
         (midpoints (reverse (send self :mid-points)))
         (cutpoints (reverse (send self :cut-points)))
         (upper-bounds (butlast cutpoints))
         (lower-bounds (rest cutpoints))
         (cum-counts (reverse (cumsum counts)))
         (cum-percents (reverse (cumsum percents)))
         (counts (reverse counts))
         (percents (reverse percents))
         (binnames 
          (reverse
           (mapcar #'(lambda (i) 
                       (format nil "Bin~d[~,2f-~,2f]" (1+ i)
                               (fuzz (select lower-bounds i))
                               (fuzz (select upper-bounds i))))
                   (reverse (iseq (length counts))))))
         (name (strcat (if (send self :prob) "Prob" "Freq") 
                            "Table-" (send stobj :name)))
         (dob (data name
                 :variables  '("LowerBound" "MidPoint" "UpperBound" "Frequency" 
                               "CumFreq" "Percent" "CumPercent")
                 :labels binnames
                 :column-label (send self :variable-label 1)
                 :row-label (send self :variable-label 0)
                 :created creator-icon
                 :creator-object stobj
                 :data (combine (bind-columns lower-bounds midpoints upper-bounds
                        counts cum-counts percents cum-percents))))
         )
    (browse-data dob)  
    ))
  

;;  Plot Methods
        
(defmeth histofreq-proto :make-plot ()
  (send self :start-buffering) 
  (send self :clear)
  (send self :horizontal-lines)
  (send self :hollow-vertical-lines)
  (send self :full-vertical-lines)
  (send self :poly-lines)
  (send self :toggle-plot)
  (if (send self :bar)
      (send self :range 0 0 (1+ (send self :num-bins)))
      (send self :adjust-to-data))
  (send self :buffer-to-screen)
  )

(defmeth histofreq-proto :toggle-plot ()
  (let* ((nn (send self :num-bins))
         (ll (* 2 (iseq (1- (* 4 nn)))))
         (lh (select ll (iseq nn)))
         (lo (select ll (+ nn (iseq (1+ nn)))))
         (lf (select ll (+ (+ nn nn 1) (iseq (1- nn)))))
         (lp (select ll (+ (* 3 nn) (iseq (1- nn))))))
    (cond ((send self :histo)
           ;(send self :title "Dynamic Histogram")
           (send self :linestart-next lh (1+ lh))
           (send self :linestart-next lo (1+ lo))
           (if (send self :full-hist)
               (send self :linestart-next lf (1+ lf))
             (send self :linestart-next lf nil))
           (send self :linestart-next lp nil)
           (send self :clear-points))
          ((send self :poly)
           ;(send self :title "Dynamic Frequency Plot")
           (send self :linestart-next lh nil)
           (send self :linestart-next lo nil)
           (send self :linestart-next lf nil)
           (send self :linestart-next lp (1+ lp))))
    (if (send self :with-points)
        (send self :poly-points)
        (send self :clear-points))
    (send self :adjust-to-data)
    (if (send self :bar) (send self :x-axis t nil 0));t t 0
    ))
 